home *** CD-ROM | disk | FTP | other *** search
/ Commodore Disk User Volume 3 #9 / Commodore_Disk_User_Vol.3_9_1990_-.d64 / graphics factory (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  8KB  |  215 lines
  1. 1 rem program: graphics factory
  2. 2 rem author : marco h. westerweel
  3. 3 rem (c)1989, all rights reserved
  4. 4 rem haaksbergen, the netherlands
  5. 5 :
  6. 10 print"[147]":dimsc$(23,38),s1$(23),gl$(54),cr$(46),d(255):dl$=chr$(20)
  7. 15 z$="                                      ":cy$="[156] ":rt$=chr$(13):cl$="[156]"
  8. 20 rl$="":sq$=""
  9. 25 bo=4:ba=15:ca=4:cx=0:pa=1:op$=left$(sq$,16)+"copy"
  10. 30 op$=op$+"modify"+rt$+"crunchreplace"+rt$+"scratchview"
  11. 35 r$(1)=left$(sq$,16)+"[146][144]copy":r$(2)=left$(sq$,16)+left$(rl$,11)+"[146][144]modify"
  12. 40 r$(3)=sq$+"[145][145][145][145][145][146][144]crunch":r$(4)=sq$+left$(rl$,11)+"[145][145][145][145][145][146][144]replace"
  13. 45 r$(5)=sq$+"[145][145][146][144]scratch":r$(6)=sq$+left$(rl$,11)+"[145][145][146][144]view":cu$="[145][157]"
  14. 50 fordd=1to255:d(dd)=9:next:fordd=1to6:readd2:d(d2)=dd:next
  15. 55 fordd=1to16:readd2:d(d2)=7:next:fordd=135to138:d(dd)=8:next
  16. 60 fordd=1to41:readd2:d(d2)=10:next
  17. 65 data 157,29,17,145,18,146,5,28,30,31,129,144,149,150,151,152,153,154,155
  18. 70 data 156,158,159,1,2,3,4,6,7,8,9,10,11,12,13,14,15,16,19,20,21,22,23,24,25
  19. 75 data 26,27,34,44,58,59,128,130,131,132,133,134,139,140,141,142,143,147,148
  20. 80 bo=4:ba=15:ca=4:cx=0:gosub585:gosub590:bl$="                "
  21. 85 print"[146][144] setting up... "
  22. 90 open8,8,8,"0:gf/dir,s,r":forgl=1to54:input#8,gl$(gl)
  23. 95 ifgl$(gl)<>"*"thenlg=lg+1
  24. 100 next:close8
  25. 105 fi$="cr/gf intro":gosub850:gosub870:forw=1to1500:nextw
  26. 110 open8,8,8,"0:cr/gf menu,s,r":fors1=1to23:input#8,s1$:input#8,s2$
  27. 115 s1$(s1)=s1$+s2$:s1$="":s2$="":next:close8:gosub590
  28. 120 pa=1:sq=1:rl=1:qx=1:sx=1:rx=1:rv$="":co$="[156]":hc$=" ":ch$="[156] "
  29. 125 cy$=sc$(1,1):print"";:fors1=1to23:print""s1$(s1):next
  30. 130 printsq$"[156]  use [144]crsr[156] & [144]return[156] to enter commands  [145]"
  31. 135 ifca$="c"thenif(ro=7orro=2)thenca$="":lg=lg-1
  32. 140 print""spc(35)"[146][144]new"
  33. 145 getgt$:ifgt$<>rt$thenifgt$<>"[157]"then145
  34. 150 ifgt$=rt$thengosub510:ro=7:gosub360:ifca$="c"then120
  35. 155 ifgt$=rt$thenifca$="a"then570
  36. 160 ifgt$="[157]"thenprint""spc(30)"[146][144]oldnew":goto165
  37. 165 getgt$:ifgt$<>rt$andgt$<>""then165
  38. 170 ifgt$=""thenprint""spc(30)"old":goto140
  39. 175 ifgt$=rt$theng2=1:g1=6:gosub340
  40. 180 print""spc(11)"[146][144]advance"
  41. 185 getgt$:ifgt$<>rt$thenifgt$<>""thenifgt$<>"[157]"then185
  42. 190 ifgt$=rt$thenifgl$(g1)<>"*"theng1=g1+6:g2=g1-5:gosub340:goto185
  43. 195 ifgt$="[157]"then210
  44. 200 ifgt$=""thentt=1:print"reverseadvance":goto260
  45. 205 gosub340:goto185
  46. 210 print"[146][144]reverseadvance"
  47. 215 getgt$:ifgt$<>rt$thenifgt$<>""thenifgt$<>""then215
  48. 220 ifgt$=rt$theng1=g1-6:g2=g1-5:gosub340:goto215
  49. 225 ifgt$=""thenprint"reverse":goto180
  50. 230 ifgt$=""thentt=1:print"reverseadvance":goto260
  51. 235 getgt$:ifgt$<>""thenifgt$<>"[145]"thenifgt$<>rt$then235
  52. 240 ifgt$=""thentt=tt+1:iftt>6thentt=6:goto260
  53. 245 ifgt$="[145]"thentt=tt-1:iftt<1thentt=0:gosub355:goto180
  54. 250 ifgt$=rt$andgl$(fl)="*"then235
  55. 255 ifgt$=rt$then270
  56. 260 printleft$(sq$,8);:forgx=g2tog1:print""gl$(gx):next
  57. 265 fl=g2+tt-1:printleft$(sq$,7+tt)"[146][144]"gl$(fl):goto235
  58. 270 ro=1:printr$(1)
  59. 275 tg=0:getgt$:forgt=1to4:ifgt$=mid$(cu$,gt,1)thentg=gt:gt=4
  60. 280 next:ifgt$=rt$andro<>2thengosub360:ifca$="c"then120
  61. 285 ifgt$=rt$then395
  62. 290 iftg=0then275
  63. 295 ontggoto300,310,320,330
  64. 300 ro=ro-2:ifro<1thenro=1
  65. 305 goto335
  66. 310 ro=ro+2:ifro>6thenro=6
  67. 315 goto335
  68. 320 ro=ro-1:ifro<1thenro=1
  69. 325 goto335
  70. 330 ro=ro+1:ifro>6thenro=6
  71. 335 printop$r$(ro):goto275
  72. 340 ifg1<6theng1=6:g2=1:goto350
  73. 345 ifg1>53theng1=54:g2=49
  74. 350 printleft$(sq$,8);:forgl=1to6:printbl$:next
  75. 355 printleft$(sq$,8);:forgl=g2tog1:print""gl$(gl):next:return
  76. 360 printsq$spc(24)"[145][145][146][144]cancelaccept"
  77. 365 getgt$:ifgt$<>rt$thenifgt$<>""then365
  78. 370 ifgt$=rt$thenca$="c":return
  79. 375 ifgt$=""thenprintsq$spc(24)"[145][145]cancel[146][144]accept"
  80. 380 getgt$:ifgt$<>rt$thenifgt$<>"[157]"then380
  81. 385 ifgt$="[157]"then360
  82. 390 ifgt$=rt$thenca$="a":return
  83. 395 onrogoto460,400,915,495,445,425,570
  84. 400 ifleft$(gl$(fl),3)="cr/"then120
  85. 405 gosub510:fx$=fi$:iflg=54then120
  86. 410 gosub360:ifca$="c"then120
  87. 415 ifgl$(fl)<>f2$thenfi$=gl$(fl):gosub845
  88. 420 gosub870:goto605
  89. 425 ifgl$(fl)<>f2$thenfi$=gl$(fl):gosub845
  90. 430 gosub870
  91. 435 getgt$:ifgt$<>chr$(133)then435
  92. 440 gosub590:goto120
  93. 445 lg$=gl$(fl):lg=lg-1:iflg=0thenlg=1:goto120
  94. 450 gosub590:print"[146][144] scratching... ";lg$:gl$(fl)=gl$(lg+1):gl$(lg+1)="*"
  95. 455 open15,8,15:print#15,"s0:"+lg$:close15:gosub590:gosub830:goto120
  96. 460 ifleft$(gl$(fl),3)<>"cr/"then120
  97. 465 ifgl$(fl)<>f2$thenfi$=gl$(fl):gosub845
  98. 470 gosub590:print"[156]...insert new disk & press"rt$"[144] c [156] to copy ";fi$
  99. 475 getc$:ifc$<>"c"then475
  100. 480 gosub785:print"[156]...insert original disk & press [144]return"
  101. 485 getrr$:ifrr$<>rt$then485
  102. 490 gosub590:goto120
  103. 495 ifleft$(gl$(fl),3)="cr/"then120
  104. 500 ifgl$(fl)<>f2$thenfi$=gl$(fl):gosub845
  105. 505 gosub870:goto605
  106. 510 fi$="":lg=lg+1:iflg=55thenlg=54:return
  107. 515 printsq$"[156] [144]return[156]:accepts name, [144]del[156]:deletes name[145]"
  108. 520 print""spc(22)"[144][146]?[157]";:forw=1to100:nextw
  109. 525 print"?[157]";:forw=1to100:nextw
  110. 530 getnf$:if(nf$<"a"ornf$>"z")and(nf$<"0"ornf$>"9")then520
  111. 535 iflen(fi$)<15thenprintnf$;:fi$=fi$+nf$:iflen(fi$)<15thenprint"[144][146]?[157]";
  112. 540 getnf$:ifnf$=rt$andlen(fi$)<16thenprint" ":return
  113. 545 ifnf$<>dl$then555
  114. 550 iffi$<>""thenfi$=left$(fi$,len(fi$)-1):print"[144][146][157]? [157][157]";:iffi$=""then520
  115. 555 if(nf$>"/"andnf$<":")ornf$=" "then535
  116. 560 ifnf$<"a"ornf$>"z"then540
  117. 565 goto535
  118. 570 gosub590:print"[146][144] initializing... "
  119. 575 fors1=1to23:fors2=1to38:sc$(s1,s2)="[156] ":next:next:gosub585:gosub590
  120. 580 print""cx$:cy$=sc$(1,1):gosub765:gosub895:goto605
  121. 585 poke53280,bo:poke53281,ba:cx$="[146][144]*":return
  122. 590 zx=0:print"";:forz=1to24:printcl$" "z$:zx=zx+40:poke1023+zx,160
  123. 595 poke55295+zx,ca:next:printcl$" "z$"[145]":poke2023,160:poke56295,ca
  124. 600 return
  125. 605 getpc$:ifpc$=""thengosub775:goto605
  126. 610 gp=d(asc(pc$)):ifgp=10then605
  127. 615 ongpgosub675,645,630,660,690,690,695,705,700
  128. 620 ifpc$=chr$(137)then120
  129. 625 goto605
  130. 630 ifsq<1orsq>22then640
  131. 635 sq=sq+1:gosub740
  132. 640 return
  133. 645 ifrl<1orrl>37then655
  134. 650 rl=rl+1:gosub740
  135. 655 return
  136. 660 ifsq<2orsq>24then670
  137. 665 sq=sq-1:gosub740
  138. 670 return
  139. 675 ifrl<2orrl>39then685
  140. 680 rl=rl-1:gosub740
  141. 685 return
  142. 690 rv$=pc$:ch$=rv$+co$+hc$:gosub765:return
  143. 695 co$=pc$:ch$=rv$+co$+hc$:gosub765:return
  144. 700 hc$=pc$:ch$=rv$+co$+hc$:gosub765:return
  145. 705 pg=asc(pc$)-134:onpggoto730,725,710,715
  146. 710 gosub785:gosub590:goto735
  147. 715 printsq$"[156]  [146][144] garbage collection [156]... please hold  [145]":th=fre(0)
  148. 720 gosub870:goto735
  149. 725 pa=1:goto735
  150. 730 pa=2:gosub765
  151. 735 return
  152. 740 qs=sq:printleft$(sq$,sx)left$(rl$,rx)cy$left$(sq$,sq)left$(rl$,rl)cx$
  153. 745 sx=sq:qx=qs:rx=rl:onpagoto750,755
  154. 750 cy$=sc$(qx,rx):goto760
  155. 755 cy$=ch$:sc$(qx,rx)=cy$
  156. 760 return
  157. 765 printleft$(sq$,sq)left$(rl$,rl)ch$
  158. 770 sc$(qx,rx)=ch$:cy$=sc$(qx,rx):return
  159. 775 printleft$(sq$,sq)left$(rl$,rl)cx$:forw=1to100:nextw
  160. 780 printleft$(sq$,sq)left$(rl$,rl)cy$:forw=1to100:nextw:return
  161. 785 gosub590:ifro=2thenfi$=fx$:fx$="":goto795
  162. 790 ifro=4thendn$=fi$:fi$="replacement file"
  163. 795 print"[146][144] saving... ";fi$" ":open8,8,8,"0:"+fi$+",s,w"
  164. 800 ifleft$(fi$,3)="cr/"thenforcr=1to46:print#8,cr$(cr):next:goto810
  165. 805 fors1=1to23:fors2=1to38:print#8,sc$(s1,s2):next:next
  166. 810 close8:ifro<>4thenifro<>1thengl$(lg)=fi$:gosub830:goto825
  167. 815 ifro=1then825
  168. 820 open15,8,15:print#15,"s0:"+dn$:print#15,"r0:"+dn$+"="+fi$:close15:fi$=dn$
  169. 825 f2$=fi$:return
  170. 830 open8,8,8,"0:dummy name,s,w":forgl=1to54:print#8,gl$(gl):next
  171. 835 close8:open15,8,15:print#15,"s0:gf/dir"
  172. 840 print#15,"r0:gf/dir=dummy name":close15:return
  173. 845 gosub590:print"[146][144] loading... ";fi$" "
  174. 850 open8,8,8,"0:"+fi$+",s,r"
  175. 855 ifleft$(fi$,3)="cr/"thenforcr=1to46:input#8,cr$(cr):next:goto865
  176. 860 fors1=1to23:fors2=1to38:input#8,sc$(s1,s2):next:next
  177. 865 close8:f2$=fi$:cy$=sc$(1,1):ch$=sc$(1,1):return
  178. 870 bo=4:ba=15:ca=4:cx=0:gosub585:gosub590:print"";
  179. 875 ifleft$(fi$,3)<>"cr/"then885
  180. 880 forcr=1to46step2:print""cr$(cr);cr$(cr+1):next:goto890
  181. 885 fors1=1to23:print"";:fors2=1to38:printsc$(s1,s2);:next:print"":next
  182. 890 f2$=fi$:ifro=0then910
  183. 895 printsq$"[156]";:onrogoto895,900,895,900,895,905,900
  184. 900 print" [144]f2[156]:save, [144]f4[156]:gar/col, [144]f5[156]:paint, [144]f7[156]:plot[145]":goto910
  185. 905 print"   press [144]f1[156] to return to options menu.[145]"
  186. 910 return
  187. 915 cr=0:ifleft$(gl$(fl),3)="cr/"then120
  188. 920 lg=lg+1:iflg=55thenlg=54:goto120
  189. 925 ifgl$(fl)<>f2$thenfi$=gl$(fl):gosub845
  190. 930 gosub590:iflen(fi$)>13thenfi$=left$(fi$,13)
  191. 935 fi$="cr/"+fi$:print"[146][144] crunching... ";fi$:open8,8,8,"0:"+fi$+",s,w"
  192. 940 s1$="":s2$="":fors1=1to23:s1$=sc$(s1,1):sc$(s1,1)="":l1$=left$(s1$,2)
  193. 945 rv$=left$(l1$,1):co$=right$(l1$,1):fors2=2to19:s2$=sc$(s1,s2)
  194. 950 sc$(s1,s2)="":l2$=left$(s2$,2):ifl2$=l1$thens1$=s1$+right$(s2$,1):goto990
  195. 955 l1$=l2$:vr$=left$(l2$,1):oc$=right$(l2$,1)
  196. 960 ifvr$<>rv$thenifoc$<>co$thens1$=s1$+s2$:rv$=vr$:co$=oc$:goto990
  197. 965 ifvr$=rv$then975
  198. 970 rv$=vr$:s1$=s1$+vr$
  199. 975 ifoc$=co$then985
  200. 980 co$=oc$:s1$=s1$+oc$
  201. 985 s1$=s1$+right$(s2$,1)
  202. 990 next:sx$=s1$:s1$=sc$(s1,20):sc$(s1,20)="":l1$=left$(s1$,2)
  203. 995 rv$=left$(s1$,1):co$=right$(l1$,1):fors2=21to38:s2$=sc$(s1,s2)
  204. 1000 sc$(s1,s2)="":l2$=left$(s2$,2)
  205. 1005 ifl2$=l1$thens1$=s1$+right$(s2$,1):goto1045
  206. 1010 l1$=l2$:vr$=left$(l2$,1):oc$=right$(l2$,1)
  207. 1015 ifvr$<>rv$thenifoc$<>co$thens1$=s1$+s2$:rv$=vr$:co$=oc$:goto1045
  208. 1020 ifvr$=rv$then1030
  209. 1025 rv$=vr$:s1$=s1$+vr$
  210. 1030 ifco$=oc$then1040
  211. 1035 co$=oc$:s1$=s1$+oc$
  212. 1040 s1$=s1$+right$(s2$,1)
  213. 1045 next:print#8,sx$:print#8,s1$:cr=cr+2:cr$(cr-1)=sx$:sx$="":cr$(cr)=s1$
  214. 1050 s1$="":next:close8:gosub590:gl$(lg)=fi$:gosub830:f2$=fi$:cr=0:goto120
  215.